Cream of the Crop 12/Cream of the Crop 12 (Part II)/Cream of the Crop 12 (Part II).iso/OS2/RXMIR12.ZIP/rxmirror.cmd

Text File | 1996-03-07 | 23.2 KB | 745 lines

/*
rxmirror v1.2         Copyright (C) A.S.V. 1995,1996          FREEWARE

read     "rxmirror.doc" for details
study    "license.doc" for legal stuff
check    "ftp.sai.msu.su:/pub/os2/internet/ftp/" for new versions
mail to  "[e-mail]" if you have questions or want to report bugs
finger   [e-mail] to get latest information

02 Mar 1996
*/

   say
   say "RxMirror  Version 1.2"
   say "Copyright (C) A.S.V. 1995, 1996. This program is freeware"
   say

   /* Loading necessary dlls */

   if RxFuncQuery("FtpLoadFuncs") then do
      say "loading RxFtp extensions..."
      call RxFuncAdd "FtpLoadFuncs","RxFtp","FtpLoadFuncs"
      if result \= "0" then do
         say "error loading RxFtp.dll"
         exit
         end
      call FtpLoadFuncs "Quiet"
   end

   if RxFuncQuery("SysLoadFuncs") then do
      say "loading RexxUtil extensions..."
      call RxFuncAdd "SysLoadFuncs","RexxUtil","SysLoadFuncs"
      if result \= "0" then do
         say "error loading RexxUtil.dll"
         exit
         end
      call SysLoadFuncs
   end

   if RxFuncQuery("Rx2LoadFuncs") then do
      say "loading Rx2Util extensions..."
      call RxFuncAdd "Rx2LoadFuncs","Rx2Util","Rx2LoadFuncs"
      if result \= "0" then do
         say "error loading Rx2Util.dll"
         exit
         end
      call Rx2LoadFuncs "Quiet"
   end

   /* setting up options */

   opt.user = "anonymous"
   opt.passwd = ""
   opt.serverhost = ""
   opt.startdir = ""
   opt.mainlog  = directory()"/.rxmirror.mainlog"
   opt.primarylog = directory()"/.rxmirror.files"
   opt.loclog = ".rxmirror.log"
   opt.inlog  = ".rxmirror.in"
   opt.outlog = ".rxmirror.out"
   opt.limit.Kbytes = 25000
   opt.limit.nfiles = 300
   opt.recovery = 0
   opt.crashdir = ""
   opt.loglvl = ""
   opt.skip = ".rxmirror.skip"
   opt.reflect = ".rxmirror.reflect"
   opt.ignoretimestamp = 1
   opt.sunserver = 0
   opt.trueremove = 0

   do forever
      lin = linein(".rxmirror.options")
      if lin = "" then leave
      if left(lin,1) = ";" then iterate
      lin = strip(lin)
      say "assigning option :" lin
      interpret "opt."lin
   end
   call stream ".rxmirror.options", "C", "CLOSE"
   say

   /* Handling arguments */

   parse arg host dir userid password .

   if host     \= "" then opt.serverhost = host
   if dir      \= "" then opt.startdir = dir
   if userid   \= "" then opt.user = userid
   if password \= "" then opt.passwd = password

   if opt.serverhost = "" then do
      say "server to mirror is not defined"
      call Usage
      exit
   end

   if opt.startdir = "" then do
      say "directory to mirror is not defined"
      call Usage
      exit
   end

   if opt.passwd = "" then do
      say "password is not defined"
      call usage
      exit
   end

   say "mirroring directory :" opt.startdir
   say "from server         :" opt.serverhost
   say "userid              :" opt.user
   say "password            :" opt.passwd
   say

   if opt.passwd = "*" then do
      say "Enter your password for" opt.user"@"opt.serverhost
      say "(will not appear when typed, empty line will abort) :"
      parse pull opt.passwd
      say ''
      if opt.passwd = "" then exit
   end

   /* initialize statistics */

   glob.fdl = 0
   glob.frm = 0
   glob.bdl = 0
   glob.brm = 0

   /* attempting crash recovery if necessary */

   signal off notready
   if opt.recovery then do
     say "attempting to recover from stopped transfer..."
     do forever
       lin = linein(opt.mainlog)
       if substr(lin,24,3) = "dir" then do
          completed = 0
          crash = substr(lin,36)
       end
       else if substr(lin,24,3) = ">>>" then completed = 1
       else if lin = "" then leave
     end
     opt.recovery = 0
     if completed = 0 then do
       say "crash condition detected; last directory is:"
       say crash
       opt.crashdir = crash
       opt.recovery = 1
     end
   end

   /* Logging into remote host */

   if pos("M", opt.loglvl) \=0 then do
     call logwrite opt.mainlog "<<<<<<<<<---------------------------------------------"
     call logwrite opt.mainlog "host      :" opt.serverhost
   end

   call FtpSetUser opt.serverhost, opt.user, opt.passwd
   if result \= 1 then call perror "bad userid/password"
   do forever
      say "trying to login to '"opt.serverhost"'..."
      call FtpPwd remotedir
      if result = 0 then leave
      if ftperrno = "FTPLOGIN" then do
         say "server is busy; waiting for 5 minutes"
         call SysSleep 60*5
         iterate
      end
      call perror "login failed"
   end

   call processdir opt.startdir

   if pos("M", opt.loglvl) \=0 then do
     call logwrite opt.mainlog "IN  " right(glob.fdl,5) "file(s)," right(nicenum(glob.bdl),11) "bytes"
     call logwrite opt.mainlog "OUT " right(glob.frm,5) "file(s)," right(nicenum(glob.brm),11) "bytes"
     call logwrite opt.mainlog ">>>>>>>>>--------------------------------------------"
   end
   say
   say "Totals :"
   say "IN  " right(glob.fdl,5) "file(s)," right(nicenum(glob.bdl),11) "bytes"
   say "OUT " right(glob.frm,5) "file(s)," right(nicenum(glob.brm),11) "bytes"
   call FTPLogoff
   exit

/* ==========================================================================
processdir:
performes mirroring for specified directory and subdirectories
*/

   processdir: procedure expose opt. glob. ftperrno
   parse arg dir0

   /* set up current directory */

   say
   say "heading to" dir0
   call FtpChDir dir0
   if result \= 0 then do
      say "*** warning : cannot chdir to" dir0
      if pos("M", opt.loglvl) \=0 then
         call logwrite opt.mainlog "!cannot chdir to '"dir0"'"
      if ftperrno \= "FTPCOMMAND" then
         call perror "cannot do chdir to" dir0
      return
      end
   call FtpPwd remotedir

   /* process subdirs */

   call getskiplist
   call FTPLs "-la .", "file."
   if result \= 0 then call perror "error getting remote file list"
   cyear = substr(date('S'), 1, 4)
   cmonth = substr(date('S'), 5, 2)
   rnd=0
   rnf=0
   rsf=0
   drop remdir.
   drop remote.
   do i=1 to file.0
      if opt.sunserver = 0 then do
         parse value file.i with rflags . . . rlen rmonth rday rtime rname
         end
      else do
         parse value file.i with rflags . . rlen rmonth rday rtime rname
         end
      rname = strip(rname)
      if isdir(rlen rflags rname) then do
        rnd = rnd + 1
        remdir.rnd.name = rname
        remdir.rnd.len = rlen
        remdir.rnd.flags = rflags
      end
      if rworth(rlen rflags rname) then do
        rnf = rnf + 1
        rsf = rsf + rlen
        rmonth = month2dec(rmonth)
        if pos(":", rtime) \= 0 then
           if rmonth > cmonth then ryear = cyear-1
           else                    ryear = cyear
        else do
           ryear = rtime
           rtime = "00:00"
        end
        remote.rnf.name = rname
        remote.rnf.len  = rlen
        remote.rnf.flags = rflags
        remote.rnf.year  = ryear
        remote.rnf.month = rmonth
        remote.rnf.day   = rday
        remote.rnf.time  = rtime
      end
   end
   drop file.

   /* check error recovery conditions */

   skipto = ""
   if opt.recovery then do
      if left(opt.crashdir,length(dir0)) \= dir0 then
         call perror "illegal crash recovery attempt;" opt.crashdir dir0
      skipto = substr(opt.crashdir,length(dir0)+2)
      sp = pos("/",skipto)
      if sp \= 0 then skipto = left(skipto,sp-1)
      say "skipping to '"skipto"'"
   end

   /* process this directory */

   call dirmirror dir0

   /* process subdirs */

   do i=1 to rnd
      if \opt.recovery then do
        call chkdirectory remdir.i.name
        call directory remdir.i.name
        if result = "" then iterate i
        call processdir dir0'/'remdir.i.name
        call directory ".."
     end
     else do
        if remdir.i.name = skipto then do
           call chkdirectory remdir.i.name
           call directory remdir.i.name
           if result = "" then iterate i
           call processdir dir0'/'remdir.i.name
           call directory ".."
        end
     end
   end i

   if sp = 0 then opt.recovery = 0

   return

/*
===========================================================================
===========================================================================
Main procedure:
mirroring of current dir on remote into current dir on local
*/

   dirmirror: procedure expose ftperrno remote. rnf rsf opt. glob.
   parse arg dir

   call FtpSetBinary "Binary"
   if pos("M", opt.loglvl) \=0 then
      call logwrite opt.mainlog "directory :" dir

   /* Build file lists */

   call getlocalfilelist
   call getreflections
   say right(rnf,5)      "remote files ("nicenum(rsf)" bytes)"
   say right(lnf,5)      "local files  ("nicenum(lsf) "bytes)"
   if lnfr <> lnf then
   say right(lnfr-lnf,5) "reflections  ("nicenum(lsfr-lsf) "bytes)"

   /* Check out if there's some file on remote and not on local disk */

   files_dl = 0
   bytes_dl = 0
   do i=1 to rnf
     found=0
     if lnfr \= 0 then
     do j=1 to lnfr
       if match(i j) then do; found=1; leave; end
     end j
     if \found then do
       say "retrieving file '"remote.i.name"'," nicenum(remote.i.len) "bytes..."
       call retrieve i
       if result = 0 then do
          files_dl = files_dl + 1
          bytes_dl = bytes_dl + remote.i.len
          if pos("F", opt.loglvl) \=0 then
             call logwrite opt.inlog right(remote.i.len,10) remote.i.name
          if pos("P", opt.loglvl) \=0 then
             call logwrite opt.primarylog "+" right(remote.i.len,10) dir"/"remote.i.name
       end
     end
     if files_dl > opt.limit.nfiles | bytes_dl/1024 > opt.limit.Kbytes then do
       say "files/bytes limit exceeded, leaving"
       if pos("M", opt.loglvl) \=0 then
          call logwrite opt.mainlog "files/bytes limit exceeded, leaving"
       leave i
     end
   end i
   if files_dl \= 0 then do
     say files_dl "file(s) retrieved from remote host"
     say
   end

   /* rebuild local list to accomodate changes */

   call getlocalfilelist

   /* Check out if there's some file on local disk and not on remote */

   files_rm = 0
   bytes_rm = 0
   remdircheck = 0
   do j=1 to lnf
     found=0
     if rnf \= 0 then
     do i=1 to rnf
       if match(i j) then do; found=1; leave; end
     end i
     if \found then do
       if \opt.trueremove then do
          if \remdircheck then call chkdirectory ".removed"
          say "removing local file '"local.j.name"' as obsolete..."
          call SysFileDelete ".removed\"local.j.name
          "@move" local.j.name ".removed\"local.j.name ">nul"
          remdircheck = 1
       end
       else do
          call SysFileDelete local.j.name
       end
       if pos("F", opt.loglvl) \=0 then
         call logwrite opt.outlog right(local.j.len,10) local.j.name
       if pos("P", opt.loglvl) \=0 then
         call logwrite opt.primarylog "-" right(local.j.len,10) dir"/"local.j.name
       files_rm = files_rm + 1
       bytes_rm = bytes_rm + local.j.len
     end
   end j
   if files_rm \= 0 then do
     say files_rm "file(s) removed because they're not present on remote host"
   end

   /* Quitting out of there */

   if files_dl \= 0 | bytes_dl \= 0 then do
     if pos("L", opt.loglvl) \=0 then
        call logwrite opt.loclog "IN  " right(files_dl,5) "file(s)," right(nicenum(bytes_dl),11) "bytes"
     say "retrieved "files_dl" file(s), "nicenum(bytes_dl)" bytes"
   end
   if files_rm \= 0 | bytes_rm \= 0 then do
     if pos("L", opt.loglvl) \=0 then
        call logwrite opt.loclog "OUT " right(files_rm,5) "file(s)," right(nicenum(bytes_rm),11) "bytes"
     say "removed  "files_rm" file(s), "nicenum(bytes_rm)" bytes"
   end

   glob.fdl = glob.fdl + files_dl
   glob.bdl = glob.bdl + bytes_dl
   glob.frm = glob.frm + files_rm
   glob.brm = glob.brm + bytes_rm

   Return

/* ------------------------------------------------------------------------- */

/* determine whether remote file worth to mirror -------------------------- */

   rworth: procedure expose skp. nskp
   parse arg len flags name
   if name = ""                then return 0
   if name = "index.html"      then return 0
   if name = "index.htm"       then return 0
   if left(name,1)  = "."      then return 0
   if left(flags,1) \= "-"     then return 0
   if len = "0"                then return 0
   if length(name) < 1         then return 0
   if words(flags) > 1         then return 0
   if pos(".bad",name) \= 0    then return 0
   if pos(".core",name) \= 0   then return 0
   if pos(".try",name) \= 0    then return 0
   if \isvalid(name)           then return 0
   do i = 1 to nskp
     if wildcardmatch(skp.i name) then return 0
   end
   return 1

/* determine whether local file worth to mirror ------------------------- */

   lworth: procedure
   parse arg name len
   if left(name,1)  = "."    then return 0
   if len = "0"              then return 0
   if length(name) < 1       then return 0
   if \isvalid(name)         then return 0
   return 1

/* do two files match ? --------------------------------------------------- */

   match: procedure expose remote. local. opt.
   parse arg i j
   if translate(strip(remote.i.name,"T",".")) \= translate(local.j.name) then return 0
   if remote.i.len \= local.j.len  then return 0
   if opt.ignoretimestamp then return 1
   /* say "comparing["remotetimestamp(i)"]vs["local.j.date"]" */
   if remotetimestamp(i) \= local.j.date then return 0
   return 1

/* fetching file from remote ---------------------------------------------- */

   retrieve: procedure expose opt. remote.
   parse arg index
   filename = remote.index.name
   call FtpGet filename, filename
   if result \= 0 then do
      say "*** warning: unable to download file '"filename"'; ftperrno is" ftperrno
      if pos("M", opt.loglvl) \=0 then
         call logwrite opt.mainlog "!unable to download '"filename"'"
      if ftperrno \= "FTPCOMMAND" then
         call perror "file fetching failed on" filename
      ftperrno = ""
      return 1
      end
   hour = substr(remote.index.time, 1, 2)
   min = substr(remote.index.time, 4, 2)
   call Rx2SetFileTimestamp filename, remote.index.day, remote.index.month, remote.index.year, hour, min, 0
   if result \= 0 then do
      say "unable to set timestamp for '"filename"'"
   end
   return 0

/* write a string to log file -------------------------------------------  */

   logwrite: procedure
   parse arg logname str
   call stream  logname, "C", "OPEN WRITE"
   call stream  logname, "C", "SEEK <0"
   call lineout logname, right(date(),11) time()' : 'str
   call stream  logname, "C", "CLOSE"
   return 1

/* process errors -------------------------------------------------------- */

   perror: procedure expose opt. ftperrno
   parse arg errstr
   say errstr ", ftp error code is" ftperrno
   if pos("M", opt.loglvl) \=0 then
      call logwrite opt.mainlog "ERR:" errstr", ftp error code is" ftperrno
   exit

/* nice digit output ------------------------------------------------------ */

   nicenum: procedure
   parse arg num
   bil = num%1000000000
   mil = num%1000000 - bil*1000
   th  = num%1000 - mil*1000 - bil*1000000
   ed  = num - th*1000 - mil*1000000 - bil*1000000000
   out = ""
   if bil \= 0 then out = out""bil","
   if mil \= 0 then if bil \= 0 then out = out""right(mil,3,'0')","
                    else             out = out""mil","
   else             if bil \= 0 then out = out""right(mil,3,'0')","
   if th  \= 0 then if bil \= 0 | mil \= 0 then out = out""right(th,3,'0')","
                    else                        out = out""th","
   else             if bil \= 0 | mil \= 0 then out = out""right(th,3,'0')","
                    if bil \= 0 | mil \= 0 | th \= 0 then out = out""right(ed,3,'0')
                    else                                  out = out""ed
   return out

/* Getting local file list ----------------------------------------------- */

   getlocalfilelist: procedure expose local. lnf lnfr lsf lsfr
   cutpos = length(directory())+2
   Call SysFileTree "*", "file.", "F"
   lnf=0
   lsf=0
   drop local.
   do i=1 to file.0
      parse value file.i with dt tm llen . lname
      lname = substr(strip(lname), cutpos)
      if lworth(lname llen) then do
        lnf = lnf + 1
        lsf = lsf + llen
        local.lnf.name = lname
        local.lnf.len = llen
        local.lnf.date = maketimestamp(dt tm)
      end
   end
   lnfr = lnf
   lsfr = lsf
   drop file.
   return

/* Getting reflections list ---------------------------------------------- */

   getreflections: procedure expose local. opt. lnf lnfr lsf lsfr
   lnfr=lnf
   do forever
      lin = linein(opt.reflect)
      if lin = "" then leave
      if left(lin,1) = ";" then iterate
      lin = strip(strip(lin),"T","\")
      say "reflecting " lin
      Call SysFileTree lin"\*", "file.", "F"
      do i=1 to file.0
         parse value file.i with dt tm llen . lname
         lname = filespec("NAME", lname)
         if lworth(lname llen) then do
           lnfr = lnfr + 1
           lsfr = lsfr + llen
           local.lnfr.name = lname
           local.lnfr.len = llen
           local.lnfr.date = maketimestamp(dt tm)
         end
      end
      drop file.
   end
   return

/* Getting skiplist ----------------------------------------------------- */

   getskiplist: procedure expose opt. skp. nskp
   nskp = 0
   do forever
      lin = linein(opt.skip)
      if lin = "" then leave
      if left(lin,1) = ";" then iterate
      lin = strip(strip(lin),"T","\")
      nskp = nskp + 1
      skp.nskp = lin
      say "added to skiplist: " skp.nskp
   end
   rc = stream(opt.skip, "C", "CLOSE")
   return

/* Checking dir presence ------------------------------------------------ */

   chkdirectory: procedure
   parse arg dirname
   Call SysFileTree dirname, "dir.", "D"
   if dir.0 = 0 then do
     call SysMkDir dirname
   end
   return

/* determine is this directory or not -------------------------------------- */

   isdir: procedure expose skp. nskp
   parse arg len flags name
   if flags = ""               then return 0
   if substr(name,1,1)  = "."  then return 0
   if substr(flags,1,1) \= "d" then return 0
   if words(flags) > 1         then return 0
   if \isvalid(name)           then return 0
   do i = 1 to nskp
     if wildcardmatch(skp.i name) then return 0
   end
   return 1

/* determine is filename valid or not -------------------------------------- */

   isvalid: procedure
   parse arg name
   if name = "" then return 0
   if words(name) > 1 then return 0
   if verify(name,,
      "!#$%&'()+,-.01234567890;=@"||,
      "ABCDEFGHIJKLMNOPQRSTUVWXYZ[]_`"||,
      "abcdefghijklmnopqrstuvwxyz{}~") \= 0 then return 0
   return 1

/* month2dec: converts month in string representation into numeric form,
   i.e. Nov -> 11 */

  month2dec: procedure
  parse arg month
  select
     when month = "Jan" then return 1
     when month = "Feb" then return 2
     when month = "Mar" then return 3
     when month = "Apr" then return 4
     when month = "May" then return 5
     when month = "Jun" then return 6
     when month = "Jul" then return 7
     when month = "Aug" then return 8
     when month = "Sep" then return 9
     when month = "Oct" then return 10
     when month = "Nov" then return 11
     when month = "Dec" then return 12
     otherwise say "wrong month" month "; assuming November"
  end /* select */
  return 1

/* maketimestamp: building date/time info for local file --------------- */

  maketimestamp: procedure
  parse arg dt tm
  year  = substr(right(dt,8),7,2)
  month = substr(right(dt,8),1,2)
  day   = substr(right(dt,8),4,2)
  hour  = substr(right(tm,6),1,2)
  min   = substr(right(tm,6),4,2)
  if (substr(right(tm,6),6,1) = "p" & hour \= 12) then hour = hour+12
  if substr(month,1,1) = " " then month = "0"substr(month,2,1)
  if substr(hour,1,1) = " " then hour = "0"substr(hour,2,1)
  return "A"year||month||day||hour":"min

/* remotetimestamp : converting remote file date/time information ------- */

  remotetimestamp: procedure expose remote.
  parse arg ind
  rday = remote.ind.day
  if length(rday) = 1 then rday = "0"rday
  if substr(rday,1,1) = " " then rday = "0"substr(rday,2,1)
  rmonth = remote.ind.month
  if length(rmonth) = 1 then rmonth = "0"rmonth
  if substr(rmonth,1,1) = " " then rmonth = "0"substr(rmonth,2,1)
  rtime = remote.ind.time
  if length(rtime) = 4 then rtime = "0"rtime
  if substr(rtime,1,1) = " " then rtime = "0"substr(rtime,2,1)
  return "A"substr(remote.ind.year,3)||rmonth||rday||rtime

/* wildcardmatch: returns 1 if matched, 0 if not ------------------------- */

  wildcardmatch: procedure
  parse arg wildcard test

  if pos("*", substr(wildcard, pos("*", wildcard)+1)) \= 0 then
     do
        say "two or more asterisks in wildcard string; terminating"
        exit
     end

  if substr(wildcard, pos("*",wildcard)+1, 1) = "?" then
     do
        say "question mark right after asterisk in wildcard string; terminating"
        exit
     end

  it = 1
  iw = 1
  do forever
     p = compare(substr(wildcard,iw), substr(test,it))
     /*say "comparing["substr(wildcard,iw)"] and ["substr(test,it)"]; result is" p*/
     if p = 0 then
        return 1
     else do
        w = substr(wildcard,iw+p-1,1)
        if w = "?" then
           do /* "?" encountered */
              if substr(test,it,1) = "" then return 0
              iw = iw + p
              it = it + p
              iterate
           end
        else if w = "*" then
                do /* "*" encountered */
                   wp = substr(wildcard,iw+p)
                   /*say "wp is ["wp"]"*/
                   if wp = "" then return 1
                   iw = iw + p
                   nq = pos("?", wp)
                   /*say "nq is" nq*/
                   if nq = 0 then
                      ss = wp
                   else
                      ss = substr(wp, 1, nq-1)
                   /*say "searching ["ss"] in ["substr(test,it+p-1)"]"*/
                   it = it + p + pos(ss, substr(test,it+p)) - 1
                end
             else
                do /* mismatch ! */
                   /*say "mismatch"*/
                   return 0
                end
     end
  end

/* Usage of rxmirror: command line options ------------------------------ */

  Usage: procedure
  say
  say "usage: rxmirror [ftp-server-host] [starting-directory] [userid] [password]"
  say "   ftp-server-host    - hostname (not IP number) of ftp server"
  say "   starting-directory - directory from which mirroring starts;"
  say "                        rxmirror will recurse into subdirs"
  say "   userid             - your login on remote server"
  say "   password           - your password on the ftp server"
  say
  say "read rxmirror.doc for additional details"
  say
  return